Try this Agent

HCL Notes/Domino 8.5 Forum (includes Notes Traveler)

Subject:

Try this Agent

I wrote following agent to extract email texts and attachments to seperate folder(NameDateTime) for each email.

Good luck
Haseeb

################
Sub Initialize
On Error Goto Errhandle

Dim s As New NotesSession
Dim db As NotesDatabase
Dim coll As NotesDocumentCollection
Dim doc As NotesDocument
Dim ws As New NotesUIWorkspace
Set db = s.CurrentDatabase
Set coll = db.UnprocessedDocuments
Dim frm As String
Dim nam As NotesName
Dim fileNum As Integer
Dim pathBase As String

pathBase=ws.Prompt (PROMPT_OKCANCELEDIT, "Path in which eMails will be extracted", "Enter Path/Folder name(The Folder should exist) i.e. C:\Temp\", "C:\Temp\")
If Len(pathBase)<1 Then
Exit Sub
End If

For i = 1 To coll.Count
Set doc = coll.GetNthDocument( i )
filenames=Evaluate("@AttachmentNames",doc)
numberoffiles=Evaluate("@Attachments", doc)
'To extract Lotus Notes user name
Set nam=New Notesname(doc.GetItemValue("From")(0))
frm=nam.Common

If Instr(frm,Chr(34)) Then 'Check for " in the name, specially in single word name
frm=Mid(frm,2,Len(frm)-2)
End If
'To suppress duplicate folder
temp=doc.PostedDate(0)
datetime=Cstr(Day(temp))+Cstr(Month(temp))+Cstr(Year(temp))+Cstr(Hour(temp))+Cstr(Minute(temp))+Cstr(Second(temp))
temp=fullpath
fullpath=pathBase+ frm+" "+datetime

If Strcompare(fullpath,temp) Then
Mkdir fullpath
End If

If numberoffiles(0)>0 Then

For filecounter=0 To numberoffiles(0)-1
Print filenames(filecounter)
Set object = doc.GetAttachment( filenames(filecounter) )

If ( object.Type = EMBED_ATTACHMENT ) Then
fileCount = fileCount + 1

Call object.ExtractFile(fullpath & "\"& filenames(filecounter) ) '

End If

Next filecounter

End If

'Generate email text
fileNum% = Freefile()
Open fullpath & "\"& "eMail.txt" For Append As fileNum%
Set rtitem = doc.GetFirstItem( "Body" )

If ( rtitem.Type = RICHTEXT ) Then
plainText = rtitem.GetFormattedText( False, 0 )
End If

' write the formatted text to the file
Print #fileNum%, "From: "+ doc.From(0)
Print #fileNum%, "Date: " +Cstr(doc.PostedDate(0))
Print #fileNum%,"Message: "+plainText
' close the file
Close #fileNum

Next
Messagebox "Selected eMail(s) & attachments are been extracted in " & pathBase & " by NameDateTime folder format"
Exit Sub

Errhandle:

' Use the Err function to return the error number and
' the Error$ function to return the error message.
Messagebox "Error" & Str(Err) & ": " & Error$ & " on line " & Cstr(Erl)
Resume Next
Exit Sub

End Sub

Feedback response number WEBB86Q5WE created by ~Jennifer Bubkrotherynds on 06/24/2010